home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSRC.EXE / GROUPOBJ.PRG < prev    next >
Text File  |  1993-05-04  |  5KB  |  151 lines
  1. PROCEDURE GroupObj
  2. *----------------------------------------------------------------------------
  3. * NAME
  4. *   GroupObj - Group objects together.
  5. *
  6. * DESCRIPTION
  7. *   Takes the current open SCR DBF file and determines the grouping
  8. *   for screen objects based on position and title.  The results
  9. *   are placed into the CURRENTID, NEXTID, and PREVID fields where
  10. *   the value is based on the record number.
  11. * 
  12. *   A group consists of single objects, where GROUPID and CURRENTID
  13. *   have the same value, or a group of objects.  The label field
  14. *   for the group will hold the record numbers for the first and
  15. *   last objects in the group.
  16. *----------------------------------------------------------------------------
  17.  
  18.   SET ORDER TO
  19.   SET FILTER TO
  20.  
  21.   STORE 0 TO ln_last, ln_next, ln_current, ln_groupid
  22.  
  23.   SCAN
  24.  
  25.     IF value_type = "B" .OR. value_type = "T"
  26.       LOOP
  27.     ENDIF
  28.  
  29.     lc_suffix = RIGHT( TRIM( fieldname ), 2 )
  30.  
  31.     DO CASE
  32.       *---------------------------------------------------------
  33.       *-- Check for control labels for comboboxes, entry fields,
  34.       *-- list boxes, radio buttons, and checkboxes
  35.       *---------------------------------------------------------
  36.       CASE lc_suffix = "_0"
  37.  
  38.         ln_groupid = RECNO()
  39.         REPLACE groupid WITH ln_groupid
  40.  
  41.         *------------------------------
  42.         *-- Group all the related items
  43.         *------------------------------
  44.         ln_possuff = AT( "_0", fieldname )
  45.         lc_objname = LEFT( fieldname, ln_possuff )
  46.         ln_next    = 0
  47.         ln_last    = 0
  48.         nMaxLen = 0
  49.         SCAN FOR lc_objname = LEFT( fieldname, ln_possuff ) .AND. ;
  50.                  value_type <> "B" .AND. ;
  51.                  RIGHT( TRIM( fieldname ), 1 ) <> "0"
  52.           ln_current = RECNO()
  53.           IF ln_next = 0
  54.             ln_next = ln_current
  55.           ENDIF
  56.           ln_last = ln_current
  57.  
  58.           REPLACE groupid   WITH ln_groupid
  59.           REPLACE currentid WITH RECNO()
  60.           IF LEFT( fieldname, 3 ) $ "RB_,CK_"
  61.             nMaxLen = MAX( decimals - col, nMaxLen )
  62.           ENDIF
  63.  
  64.         ENDSCAN                          
  65.  
  66.         *---------------------------------------------------------
  67.         *-- Store the group's first and last objects in previd and
  68.         *-- nextid fields.
  69.         *---------------------------------------------------------
  70.         GOTO ln_groupid
  71.         REPLACE previd WITH ln_next
  72.         REPLACE nextid WITH ln_last
  73.  
  74.         *---------------------------------------------------------------
  75.         *-- Make one last scan for the group to adjust length of CB & RB
  76.         *---------------------------------------------------------------
  77.         IF LEFT( fieldname, 3 ) $ "RB_,CK_"
  78.           REPLACE decimals WITH col + nMaxLen ;
  79.              FOR lc_objname = LEFT( fieldname, ln_possuff ) .AND. ;
  80.                  value_type <> "B"                          .AND. ;
  81.                  RIGHT( TRIM( fieldname ), 1 ) <> "0"
  82.         ENDIF
  83.         GOTO ln_groupid
  84.  
  85.       *-----------------------------------------------------------
  86.       *-- Check for single item controls, like buttons, checkboxes
  87.       *-- and objects without titles.
  88.       *-----------------------------------------------------------
  89.       CASE LEFT( lc_suffix, 1 ) <> "_" .AND. LEFT( fieldname, 3 ) <> "TI_"
  90.  
  91.         ln_groupid = RECNO()
  92.         REPLACE currentid WITH ln_groupid
  93.         REPLACE groupid   WITH ln_groupid
  94.  
  95.       CASE lc_suffix = "_1" .AND. ISBLANK( groupid )
  96.         ln_groupid = RECNO()
  97.         REPLACE currentid WITH ln_groupid
  98.         REPLACE groupid   WITH ln_groupid
  99.  
  100.  
  101.     ENDCASE
  102.  
  103.   ENDSCAN
  104.  
  105.   *----------------------------------------------------------
  106.   *-- Now scan the objects that can get focus and fill in the
  107.   *-- NEXTID and PREVID values.
  108.   *----------------------------------------------------------
  109.   SET ORDER TO ObjOrder
  110.   SET FILTER TO .NOT. ISBLANK( currentid )
  111.   GO TOP
  112.   DO WHILE .NOT. EOF()
  113.     nCurr = currentid
  114.  
  115.     *-- Get the previous value
  116.     SKIP -1
  117.     IF BOF()
  118.       GO BOTTOM
  119.       nPrev = currentid
  120.       GO TOP
  121.     ELSE
  122.       nPrev = currentid
  123.       SKIP
  124.     ENDIF
  125.  
  126.     *-- Get the next value
  127.     SKIP
  128.     IF EOF()
  129.       GO TOP
  130.       nNext = currentid
  131.       GO BOTTOM
  132.     ELSE
  133.       nNext = currentid
  134.       SKIP -1
  135.     ENDIF
  136.  
  137.     *-- Store the values
  138.     REPLACE nextid WITH nNext, previd WITH nPrev
  139.  
  140.     SKIP
  141.  
  142.   ENDDO
  143.   SET FILTER TO
  144.   SET ORDER TO
  145.  
  146. RETURN
  147. *-- EOP: GroupObj
  148.  
  149.  
  150. 
  151.